home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue61 / Stream / uGlobals.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-04-11  |  4.6 KB  |  194 lines
  1. unit uGlobals;
  2.  
  3. interface
  4.  
  5. uses Windows, Forms, classes, extctrls, graphics, jpeg, sysutils;
  6.  
  7. type
  8.   TSSMode = (ssSetPwd,ssPreview,ssConfig,ssRun);
  9.  
  10.   TSSFileImageLocations = class(TComponent)
  11.   private
  12.     ListItems : TStringList;
  13.     function GetCommaList: string;
  14.     function GetItems(index: integer): Integer;
  15.     procedure SetCommaList(const Value: string);
  16.     procedure SetItems(index: integer; const Value: Integer);
  17.     function GetCount: integer;
  18.   public
  19.     constructor Create(AOwner : TComponent); override;
  20.     destructor Destroy; override;
  21.     property Items[index : integer] : Integer read GetItems write SetItems;
  22.     property Count : integer read GetCount;
  23.     function Add(Loc : integer) : integer;
  24.   published
  25.     property CommaList : string read GetCommaList write SetCommaList;
  26.   end;
  27.  
  28.   TSSImage = class(TComponent)
  29.   private
  30.     FFilename: string;
  31.     FPicture: TPicture;
  32.     procedure SetPicture(const Value: TPicture);
  33.   public
  34.     constructor Create(AOwner : TComponent); override;
  35.     destructor Destroy; override;
  36.     procedure Execute(ToPicture : TPicture); virtual;
  37.   published
  38.     property Picture : TPicture read FPicture write SetPicture;
  39.     property Filename : string read FFilename write FFilename;
  40.   end;
  41.  
  42.   TSSTextImage = class(TSSImage)
  43.   private
  44.     FText: String;
  45.   public
  46.     procedure Execute(ToPicture : TPicture); override;
  47.   published
  48.     property Text : String read FText write FText;
  49.   end;
  50.  
  51. const
  52.   SSMode      : TSSMode = ssRun;
  53.  
  54. procedure ReadIniFile;
  55. procedure WriteIniFile;
  56.  
  57. var
  58.   Interval : Integer;
  59.   Section     : string;
  60.  
  61. implementation
  62.  
  63. uses
  64.   IniFiles;
  65.  
  66. procedure ReadIniFile;
  67. var
  68.   IniFile : TIniFile;
  69. begin
  70.   IniFile := TIniFile.Create('CONTROL.INI');
  71.   Interval := IniFile.ReadInteger(Section,'Interval',5000);
  72.   IniFile.Free;
  73. end;
  74.  
  75. procedure WriteIniFile;
  76. var
  77.   IniFile : TIniFile;
  78. begin
  79.   IniFile := TIniFile.Create('CONTROL.INI');
  80.   IniFile.WriteInteger(Section,'Interval',Interval);
  81.   IniFile.Free;
  82. end;
  83.  
  84. { TSSImage }
  85.  
  86. constructor TSSImage.Create(AOwner: TComponent);
  87. begin
  88.   inherited;
  89.   FPicture := TPicture.Create;
  90. end;
  91.  
  92.  
  93. destructor TSSImage.Destroy;
  94. begin
  95.   FPicture.Free;
  96.   inherited;
  97. end;
  98.  
  99. procedure TSSImage.Execute(ToPicture : TPicture);
  100. begin
  101.    ToPicture.Assign(FPicture);
  102. end;
  103.  
  104. procedure TSSImage.SetPicture(const Value: TPicture);
  105. begin
  106.   FPicture.Assign(Value);
  107. end;
  108.  
  109. { TSSTextImage }
  110.  
  111. procedure TSSTextImage.Execute(ToPicture: TPicture);
  112. var
  113.   tmpBitmap : TBitmap;
  114.   x, y : integer;
  115.   s : TSize;
  116. begin
  117.   inherited Execute(ToPicture);
  118.   tmpBitmap := TBitmap.Create;
  119.   try
  120.     tmpBitmap.Width := ToPicture.Width;
  121.     tmpBitmap.Height := ToPicture.Height;
  122.     tmpBitmap.Canvas.Draw(0,0,ToPicture.Graphic);
  123.  
  124.     tmpBitmap.Canvas.Brush.Style := bsClear;
  125.     tmpBitmap.Canvas.Font.Size := 32;
  126.     tmpBitmap.Canvas.Font.Color := clWHite;
  127.     tmpBitmap.Canvas.Font.Name := 'Arial';
  128.     s := tmpBitmap.Canvas.TextExtent(FText);
  129.  
  130.     x := ( ToPicture.Width div 2) - (s.cx div 2);
  131.     y := ( ToPicture.Height div 2) - (s.cy div 2);
  132.     tmpBitmap.Canvas.TextOut(x,y,FText);
  133.  
  134.     ToPicture.Bitmap.Assign(tmpBitmap);
  135.   finally
  136.      tmpBitmap.Free;
  137.   end;
  138. end;
  139.  
  140. { TSSFileImageLocations }
  141.  
  142. constructor TSSFileImageLocations.Create(AOwner: TComponent);
  143. begin
  144.   inherited;
  145.   ListItems := TStringList.Create;
  146. end;
  147.  
  148. destructor TSSFileImageLocations.Destroy;
  149. begin
  150.   ListItems.Free;
  151.   inherited;
  152. end;
  153.  
  154. function TSSFileImageLocations.GetCommaList: string;
  155. begin
  156.   Result := ListItems.CommaText;
  157. end;
  158.  
  159. procedure TSSFileImageLocations.SetCommaList(const Value: string);
  160. begin
  161.   ListItems.CommaText := Value;
  162. end;
  163.  
  164. function TSSFileImageLocations.GetItems(index: integer): Integer;
  165. begin
  166.   if (index > ListItems.Count-1) or (index < 0) then raise Exception.Create('Index is out of bounds');
  167.   result := StrToIntDef(ListItems[index],0);
  168. end;
  169.  
  170. procedure TSSFileImageLocations.SetItems(index: integer;
  171.   const Value: Integer);
  172. begin
  173.   if (index > ListItems.Count-1) or (index < 0) then raise Exception.Create('Index is out of bounds');
  174.   ListItems[index] := IntToStr(Value);
  175. end;
  176.  
  177. function TSSFileImageLocations.Add(Loc: integer): integer;
  178. begin
  179.   result := ListItems.Add(IntToStr(Loc));
  180. end;
  181.  
  182. function TSSFileImageLocations.GetCount: integer;
  183. begin
  184.   result := ListItems.Count;
  185. end;
  186.  
  187. initialization
  188.    classes.RegisterClass(TSSFileImageLocations);
  189.    classes.RegisterClass(TSSImage);
  190.    classes.RegisterClass(TSSTextImage);
  191.    Section := 'Screen Saver.'+ExtractFileName(Application.ExeName)+' Screen Saver';
  192. end.
  193.  
  194.